home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / encryp / encryp.bas next >
Encoding:
BASIC Source File  |  1995-05-09  |  1.9 KB  |  53 lines
  1.  
  2. ' Problem noted when offset = a single digit hex number
  3. ' decode routine is looking for 2 digits. simple fix noted below
  4. 'fix by Michael W. Smith (74001,457) of NBS
  5. ' routine look good!
  6. '
  7. Function crypt (Action As String, Key As String, Src As String) As String
  8. Dim Count As Integer, KeyPos As Integer, KeyLen As Integer, SrcAsc As Integer, dest As String, offset As Integer, TmpSrcAsc, SrcPos
  9. KeyLen = Len(Key)
  10.  
  11. If Action = "E" Then
  12.     Randomize
  13.     offset = (Rnd * 10000 Mod 255) + 1
  14.  
  15.     dest = Hex$(offset)  ' problem with "offset" of single digit hex numbers
  16.     ' when decodeing, decode procedure is looking for 2 digits, whereis lower number produce single digit hex numbers (ie 1,2,3,12...)
  17.     If Len(dest) = 1 Then   ' adds 0 in front of single digit hex numbers
  18.         dest = "0" + dest
  19.     End If
  20.  
  21.     For SrcPos = 1 To Len(Src)
  22.         SrcAsc = (Asc(Mid$(Src, SrcPos, 1)) + offset) Mod 255
  23.         If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
  24.         'Fill Dest$ with HEX representation of Encrypted field
  25.         'Hex used to keep nasties such as eof or lf from mangling stream
  26.         'Use format$ to make Hex$ return " 0" instead of "0" when the same
  27.         'values are Xor'ed together (Null) - keeps placeholder for decrypt
  28.         SrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
  29.         dest = dest + Format$(Hex$(SrcAsc), "@@")
  30.         offset = SrcAsc
  31.  
  32.     Next
  33.  
  34. ElseIf Action = "D" Then
  35.     offset = Val("&H" + Left$(Src, 2))
  36.     For SrcPos = 3 To Len(Src) Step 2
  37.         SrcAsc = Val("&H" + Trim(Mid$(Src, SrcPos, 2)))
  38.         If KeyPos < KeyLen Then KeyPos = KeyPos + 1 Else KeyPos = 1
  39.         TmpSrcAsc = SrcAsc Xor Asc(Mid$(Key, KeyPos, 1))
  40.         If TmpSrcAsc <= offset Then
  41.             TmpSrcAsc = 255 + TmpSrcAsc - offset
  42.         Else
  43.             TmpSrcAsc = TmpSrcAsc - offset
  44.         End If
  45.         dest = dest + Chr(TmpSrcAsc)
  46.         offset = SrcAsc
  47.     Next
  48.  
  49. End If
  50. crypt = dest
  51. End Function
  52.  
  53.